home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / fb386 / superedt / s_graffi.bas next >
BASIC Source File  |  1991-10-18  |  9KB  |  215 lines
  1. 1000 SCREEN@ 0:CLEAR ,,,400000:CLS:DEF PEN 0,1:DEFINT A-Z
  2. 1010 DIM AUNIT&(61919),MAPUNIT&(33023)
  3. 1015 DIM AUNIT1(959),MAPUNIT1(255)
  4. 1020 DIM AUNIT$(47),MAPUNIT$(31),MAPUNIT1$(31),PAT&(31),DAT(2000)
  5. 1025 DIM UNITV$(1000),UNITNAME$(129)
  6. 1030 DEF FNDATA(X)=(X \ &H10)+(X MOD &H10)*&H10
  7. 1040 FOR I=14 TO 17:PAT&(I)=&H00C00300:NEXT
  8. 1045 PALETTE 15,[0,0,255]:
  9. 1050 GOSUB *LOAD
  10. 1055 MOUSE 0:MOUSE 1,,,1
  11. 1060 CLS:GOSUB *SELECT:CLS
  12. 1070 DEF PEN 0,1
  13. 1090 LINE(321,0)-(450,129),PSET,7,B:LINE(321,129)-(354,162),PSET,7,B
  14. 1100 LINE(0,0)-(321,193),PSET,7,B:LINE(0,193)-(81,242),PSET,7,B
  15. 1103 PUT@A(1,1)-(80,48),AUNIT&,PSET,4,4,,NO*480
  16. 1104 GET@(1,1)-(80,48),AUNIT&,PSET,4,4,,NO*480
  17. 1105 PUT@A(1,1)-(320,192),AUNIT&,PSET,4,4,,NO*480
  18. 1190 PUT@A(322,1)-(449,128),MAPUNIT&,PSET,4,4,,NO*128
  19. 1200 PUT@A(322,1)-(449,128),MAPUNIT&,MATTE,4,4,0,NO*128
  20. 1280 OFFSET=NO*4:DAT=0
  21. 1290 FOR I=0 TO 31
  22. 1300  IF DAT<113 MAPUNIT$(I)=MID$(MAPUNITLOAD$(OFFSET),DAT+1,16):DAT=DAT+16 ELSE MAPUNIT$(I)=MID$(MAPUNITLOAD$(OFFSET),DAT+1,128-DAT)+MID$(MAPUNITLOAD$(OFFSET+1),1,DAT-112):OFFSET=OFFSET+1:DAT=DAT-112
  23. 1310  FOR J=0 TO 15
  24. 1320    B$=RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT$(I),J+1,2))),2)
  25. 1330    IF MID$(B$,2,1)="F" PSET(J*2+322,I+130)
  26. 1340    IF MID$(B$,1,1)="F" PSET(J*2+323,I+130)
  27. 1350  NEXT
  28. 1360 NEXT
  29. 1370 GET@A(322,130)-(353,161),DAT:PUT@A(322,1)-(353,32),DAT,,4,4
  30. 1380 GET@A(1,194)-(80,241),DAT:PUT@A(1,1)-(80,48),DAT,,4,4
  31. 1390 SYMBOL(0,464),"CHANGE_UNIT  SAVE",1,1,7
  32. 1400 SYMBOL(0,432),"COPY  CLEAR",1,1,7
  33. 1410 SYMBOL(0,258),UNITNAME$(NO),1,1,7,,,1
  34. 1420 LINE(332,170)-(348,186),PSET,7,B
  35. 1430 LINE(333,171)-(347,185),PSET,7,BF
  36. 1440 LINE(352,170)-(368,186),PSET,7,B
  37. 1450 LINE(353,171)-(367,185),PSET,1,BF
  38. 1460 DEF PEN 1,PAT&
  39. 1470 C=1:GOSUB *COLOR
  40. 1480 WHILE (MOUSE(2,0) OR MOUSE(2,1))=0:WEND
  41. 1490 X=MOUSE(0):Y=MOUSE(1)
  42. 1500 IF X>0 AND X<321 AND Y>0 AND Y<193 THEN *AUNIT
  43. 1510 IF X>321 AND X<450 AND Y>0 AND Y<129 THEN *MAPUNIT
  44. 1520 IF X>332 AND X<348 AND Y>170 AND Y<186 C=1:GOSUB *COLOR
  45. 1530 IF X>352 AND X<368 AND Y>170 AND Y<186 C=2:GOSUB *COLOR
  46. 1540 IF X>0 AND X<88 AND Y>464 AND Y<479 THEN *CHANGE_UNIT
  47. 1550 IF X>104 AND X<128 AND Y>464 AND Y<479 THEN *SAVE
  48. 1560 IF X>0 AND X<32 AND Y>432 AND Y<448 THEN *COPY
  49. 1570 IF X>48 AND X<88 AND Y>432 AND Y<448 THEN *CLEAR
  50. 1580 GOTO 1480
  51. 1590 *AUNIT
  52. 1600 X=(X-1)\4:Y=(Y-1)\4:A$=""
  53. 1610 IF MOUSE(2,0) PSET(X*4+2,Y*4+2):DEF PEN 0,1:PSET(X+1,Y+194):DEF PEN 1,PAT&:A$="F"
  54. 1620 IF MOUSE(2,1) PSET(X*4+2,Y*4+2),0:DEF PEN 0,1:PSET(X+1,Y+194),0:DEF PEN 1,PAT&:A$="0"
  55. 1630 IF X MOD 2 = 0 MID$(AUNIT$(Y),X\2+1,1)=CHR$(VAL("&H"+LEFT$(RIGHT$("0"+HEX$(ASC(MID$(AUNIT$(Y),X\2+1,1))),2),1)+A$))
  56. 1640 IF X MOD 2 = 1 MID$(AUNIT$(Y),X\2+1,1)=CHR$(VAL("&H"+A$+RIGHT$(HEX$(ASC(MID$(AUNIT$(Y),X\2+1,1))),1)))
  57. 1650 GOTO 1480
  58. 1660 *MAPUNIT
  59. 1670 X=(X-322)\4:Y=(Y-1)\4
  60. 1680 IF MOUSE(2,1) THEN *MAPUNIT3
  61. 1690 IF MOUSE(2,0) IF C=1 THEN *MAPUNIT1 ELSE *MAPUNIT2
  62. 1700 *MAPUNIT1
  63. 1710 PSET(X*4+323,Y*4+2):DEF PEN 0,1:PSET(X+322,Y+130):DEF PEN 1,PAT&
  64. 1720 IF X MOD 2 = 0 MID$(MAPUNIT$(Y),X\2+1,1)=CHR$(VAL("&H"+LEFT$(RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT$(Y),X\2+1,1))),2),1)+"F"))
  65. 1730 IF X MOD 2 = 0 MID$(MAPUNIT1$(Y),X\2+1,1)=CHR$(VAL("&H"+LEFT$(RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT1$(Y),X\2+1,1))),2),1)+"0"))
  66. 1740 IF X MOD 2 = 1 MID$(MAPUNIT$(Y),X\2+1,1)=CHR$(VAL("&HF"+RIGHT$(HEX$(ASC(MID$(MAPUNIT$(Y),X\2+1,1))),1)))
  67. 1750 IF X MOD 2 = 1 MID$(MAPUNIT1$(Y),X\2+1,1)=CHR$(VAL("&H0"+RIGHT$(HEX$(ASC(MID$(MAPUNIT1$(Y),X\2+1,1))),1)))
  68. 1760 GOTO 1480
  69. 1770 *MAPUNIT2
  70. 1780 PSET(X*4+323,Y*4+2),1:DEF PEN 0,1:PSET(X+322,Y+130),1:DEF PEN 1,PAT&
  71. 1790 IF X MOD 2 = 0 MID$(MAPUNIT1$(Y),X\2+1,1)=CHR$(VAL("&H"+LEFT$(RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT1$(Y),X\2+1,1))),2),1)+"F"))
  72. 1800 IF X MOD 2 = 0 MID$(MAPUNIT$(Y),X\2+1,1)=CHR$(VAL("&H"+LEFT$(RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT$(Y),X\2+1,1))),2),1)+"0"))
  73. 1810 IF X MOD 2 = 1 MID$(MAPUNIT1$(Y),X\2+1,1)=CHR$(VAL("&HF"+RIGHT$(HEX$(ASC(MID$(MAPUNIT1$(Y),X\2+1,1))),1)))
  74. 1820 IF X MOD 2 = 1 MID$(MAPUNIT$(Y),X\2+1,1)=CHR$(VAL("&H0"+RIGHT$(HEX$(ASC(MID$(MAPUNIT$(Y),X\2+1,1))),1)))
  75. 1830 GOTO 1480
  76. 1840 *MAPUNIT3
  77. 1850 PSET(X*4+323,Y*4+2),0:DEF PEN 0,1:PSET(X+322,Y+130),0:DEF PEN 1,PAT&
  78. 1860 IF X MOD 2 = 0 MID$(MAPUNIT1$(Y),X\2+1,1)=CHR$(VAL("&H"+LEFT$(RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT1$(Y),X\2+1,1))),2),1)+"0"))
  79. 1870 IF X MOD 2 = 0 MID$(MAPUNIT$(Y),X\2+1,1)=CHR$(VAL("&H"+LEFT$(RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT$(Y),X\2+1,1))),2),1)+"0"))
  80. 1880 IF X MOD 2 = 1 MID$(MAPUNIT1$(Y),X\2+1,1)=CHR$(VAL("&H0"+RIGHT$(HEX$(ASC(MID$(MAPUNIT1$(Y),X\2+1,1))),1)))
  81. 1890 IF X MOD 2 = 1 MID$(MAPUNIT$(Y),X\2+1,1)=CHR$(VAL("&H0"+RIGHT$(HEX$(ASC(MID$(MAPUNIT$(Y),X\2+1,1))),1)))
  82. 1900 GOTO 1480
  83. 1910 *CHANGE_UNIT
  84. 1920 GOSUB *SAVE_MEM:GOTO 1060
  85. 1930 *SAVE_MEM
  86. 1940 OFFSET=NO*4:DAT=0
  87. 1950 FOR I=0 TO 3
  88. 1960  FOR J=0 TO 7
  89. 1970   MID$(MAPUNITLOAD$(OFFSET),J*16+1,16)=MAPUNIT$(I*8+J)
  90. 1980  NEXT
  91. 1990  OFFSET=OFFSET+1
  92. 2000 NEXT
  93. 2010 OFFSET=NO*4:DAT=0
  94. 2020 FOR I=0 TO 3
  95. 2030  FOR J=0 TO 7
  96. 2040   MID$(MAPUNIT1LOAD$(OFFSET),J*16+1,16)=MAPUNIT1$(I*8+J)
  97. 2050  NEXT
  98. 2060  OFFSET=OFFSET+1
  99. 2070 NEXT
  100. 2080 OFFSET=NO*15:DAT=0
  101. 2090 FOR I=0 TO 47
  102. 2100  IF DAT=128 OFFSET=OFFSET+1:DAT=0
  103. 2110  IF DAT<89 MID$(AUNITLOAD$(OFFSET),DAT+1,40)=AUNIT$(I):DAT=DAT+40 ELSE MID$(AUNITLOAD$(OFFSET),DAT+1,128-DAT)=LEFT$(AUNIT$(I),128-DAT):MID$(AUNITLOAD$(OFFSET+1),1,DAT-88)=RIGHT$(AUNIT$(I),DAT-88):OFFSET=OFFSET+1:DAT=DAT-88
  104. 2120 NEXT
  105. 2130 RETURN
  106. 2140 *COPY:N=NO:GOSUB *SAVE_MEM
  107. 2150 CLS:SYMBOL(  0,464),"ＦＲＯＭ",1,1:GOSUB *SELECT
  108. 2151     IF F=1 RETURN
  109. 2152     SYMBOL( 64,464),UNITNAME$(NO),1,1:FROM=NO
  110. 2153     WHILE MOUSE(2,0):WEND
  111. 2154     SYMBOL(208,464),"ＴＯ",1,1:F=0:GOSUB 3110
  112. 2155     IF F=1 RETURN
  113. 2156     SYMBOL(240,464),UNITNAME$(NO),1,1:T=NO
  114. 2160 FOR I=0 TO 15
  115. 2170  AUNITLOAD$(T*15+I)=AUNITLOAD$(FROM*15+I)
  116. 2180 NEXT
  117. 2190 FOR I=0 TO 4
  118. 2200  MAPUNITLOAD$(T*4+I)=MAPUNITLOAD$(FROM*4+I)
  119. 2210  MAPUNIT1LOAD$(T*4+I)=MAPUNIT1LOAD$(FROM*4+I)
  120. 2220 NEXT
  121. 2230 CLS:NO=N
  122. 2240 GOTO 1070
  123. 2250 *CLEAR
  124. 2260 FOR I=0 TO 47
  125. 2270  AUNIT$(I)=STRING$(40,CHR$(0))
  126. 2280 NEXT
  127. 2290 FOR I=0 TO 31
  128. 2300  MAPUNIT$(I)=STRING$(16,CHR$(0))
  129. 2310  MAPUNIT1$(I)=STRING$(16,CHR$(&HFF))
  130. 2320 NEXT
  131. 2325 DEF PEN 0,1
  132. 2330 LINE(322,130)-(353,161),PSET,1,BF
  133. 2331 LINE(1,194)-(80,241),PSET,0,BF
  134. 2332 GET@A(322,130)-(353,161),DAT:PUT@A(322,1)-(353,32),DAT,,4,4
  135. 2333 GET@A(1,194)-(80,241),DAT:PUT@A(1,1)-(80,48),DAT,,4,4
  136. 2334 DEF PEN 1,PAT&
  137. 2339 GOTO 1480
  138. 2340 END
  139. 2350 *LOAD '---------------------------------------------------------
  140. 2360 LOAD@ "A:AUNIT.DAT",AUNIT&
  141. 2400 LOAD@ "A:MAPUNIT.DAT",MAPUNIT&
  142. 2461 OPEN "A:UNITV.DAT" FOR INPUT AS #1
  143. 2462 A$=INPUT$(253,1):A$=INPUT$(253,1):A$=INPUT$(200,1):A$=INPUT$(200,1)
  144. 2463 A$=INPUT$(130,1)
  145. 2464 FOR I=0 TO 125
  146. 2465  UNITNAME$(I)=INPUT$(18,#1):A$=INPUT$(62,#1)
  147. 2466 NEXT:CLOSE
  148. 2470 RETURN
  149. 2480 *COLOR '---------------------------------------------------------
  150. 2490 DEF PEN 0,1
  151. 2500 LINE(330,168)-(370,188),PSET,0,BF
  152. 2510 LINE(332,170)-(348,186),PSET,7,B
  153. 2520 LINE(352,170)-(368,186),PSET,7,B
  154. 2530 IF C=1 LINE(330,168)-(350,188),PSET,7,BF
  155. 2540 IF C=2 LINE(350,168)-(370,188),PSET,7,BF
  156. 2550 LINE(333,171)-(347,185),PSET,7,BF
  157. 2560 LINE(353,171)-(367,185),PSET,1,BF
  158. 2570 DEF PEN 1,PAT&
  159. 2580 RETURN
  160. 2590 *SAVE '---------------------------------------------------------
  161. 2600 GOSUB *SAVE_MEM
  162. 2610 KILL "A:AUNIT.DAT"
  163. 2620 OPEN "A:AUNIT.DAT" FOR OUTPUT AS #1
  164. 2630 FOR I=0 TO 15*129-1
  165. 2640  PRINT #1,AUNITLOAD$(I);
  166. 2650 NEXT:CLOSE
  167. 2660 KILL "A:MAPUNIT.DAT"
  168. 2670 OPEN "A:MAPUNIT.DAT" FOR OUTPUT AS #1
  169. 2680 FOR I=0 TO 4*129-1
  170. 2690  PRINT #1,MAPUNITLOAD$(I);
  171. 2700 NEXT
  172. 2710 FOR I=0 TO 4*129-1
  173. 2720  PRINT #1,MAPUNIT1LOAD$(I);
  174. 2730 NEXT:CLOSE
  175. 2740 END
  176. 2750 *PUT '---------------------------------------------------------
  177. 2760 DEF PEN 0,1
  178. 2770 LINE(322,130)-(353,161),PSET,0,BF
  179. 2780 LINE(1,194)-(80,241),PSET,0,BF
  180. 2790 FOR I=0 TO 47
  181. 2800  FOR J=0 TO 39
  182. 2810    B$=RIGHT$("0"+HEX$(ASC(MID$(AUNIT$(I),J+1,2))),2)
  183. 2820    IF MID$(B$,2,1)="F" PSET(J*2+1,I+194)
  184. 2830    IF MID$(B$,1,1)="F" PSET(J*2+2,I+194)
  185. 2840  NEXT
  186. 2850 NEXT
  187. 2860 FOR I=0 TO 31
  188. 2870  FOR J=0 TO 15
  189. 2880    B$=RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT1$(I),J+1,2))),2)
  190. 2890    IF MID$(B$,2,1)="F" PSET(J*2+322,I+130),%9
  191. 2900    IF MID$(B$,1,1)="F" PSET(J*2+323,I+130),%9
  192. 2910  NEXT
  193. 2920 NEXT
  194. 2930 FOR I=0 TO 31
  195. 2940  FOR J=0 TO 15
  196. 2950    B$=RIGHT$("0"+HEX$(ASC(MID$(MAPUNIT$(I),J+1,2))),2)
  197. 2960    IF MID$(B$,2,1)="F" PSET(J*2+322,I+130)
  198. 2970    IF MID$(B$,1,1)="F" PSET(J*2+323,I+130)
  199. 2980  NEXT
  200. 2990 NEXT
  201. 3000 GET@A(322,130)-(353,161),DAT:PUT@A(322,1)-(353,32),DAT,,4,4
  202. 3010 GET@A(1,194)-(80,241),DAT:PUT@A(1,1)-(80,48),DAT,,4,4
  203. 3020 DEF PEN 1,PAT&
  204. 3030 RETURN
  205. 3040 *SELECT '-------------------------------------------------------
  206. 3050 F=0
  207. 3080 FOR I=0 TO 125
  208. 3090  SYMBOL((I MOD 5)*128,(I\5)*16),UNITNAME$(I),1,1
  209. 3100 NEXT
  210. 3110 WHILE (MOUSE(2,0) OR MOUSE(2,1))=0:WEND
  211. 3115 IF MOUSE(2,1) F=1:RETURN
  212. 3120 NO=(MOUSE(1)\16)*5+(MOUSE(0)\128)
  213. 3130 RETURN
  214. 21521     SYMBOL(0,464),"ＦＲＯＭ":GOSUB *SELECT
  215.